perm filename M11X.F4[M11,LCS]2 blob
sn#396927 filedate 1978-11-22 generic text, type T, neo UTF8
00100 CPASS3 PASS 3 MAIN PROGRAM
00200 C *** MUSIC V ***
00300 INTEGER PEAK,CONV
00400 CXX DOUBLE PRECISION JFLNM,JTRNS,JBLA
00500 DIMENSION T(50),TI(50),ITI(50)
00600 CSS COMMON I(513) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,RPEAK,NBUF
00700 COMMON I(513) /P/P(50) /FINOUT/PEAK,RPEAK,NBUF
00800 1 /GENS/GENS(3072) /IRAN/IRAN /CONV/CONV,INIOUT,JFLNM
00900 1 /LFUNC/LFUNC /IFIRST/IFIRST,IDT
01000
01100 C NOPCD=NUM.OF OP CODES, ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
01200 DATA NOPCD/14/, ISRT/10000/, LFUNC/512/
01300 1 , NPAR/35/, NINS/27/, LBLK/512/
01400 C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
01500
01600 COMMON /INS/INS(400),IDEF(100) /NT/RNT(1000) /ROUT/ROUT(3072)
01700 C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, ROUT=OUTPUT BLOCK (B1→B6)(6*512)
01800 EQUIVALENCE (I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3))
01900 1, (I5,I(5)),(I6,I(6))
02000 DATA JTRNS/'TRNS '/,JBLA/' '/
02100 DATA IIIRD/976545367/
02200 C INIALIZATION OF PIECE
02300 C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
02400 CXX IRAN=32767
02500 CXX IRAN=I(7)+1
02600 IRAN=IIIRD
02700 NBUF=512
02800 CC******* NREAD = 3
02900 CC******* NWRITE = 2
03000 NREAD=21
03100 C PDP DSK1=DEV.21
03200 NWRITE=1
03300 C PDP DSK=DEV.1
03400 CXX REWIND NREAD
03500 CXX REWIND NWRITE
03600 CZZ44 TYPE 401
03700 CZZ ACCEPT 501,JFLNM,CONV
03800 C TYPE <CR> FOR DEFAULT NAME(FOR21.DAT), ADD A NUM. TO WRITE SMPLS TO BE PLAYED.
03900 CC IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
04000 CXX CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
04100 CZZ CALL IFILE(21,JFLNM)
04200 C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
04300 401 FORMAT(' TYPE FILE NAME'/)
04400 501 FORMAT(A5,5I)
04500 1000 INIOUT=-1
04600 C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
04700 IFIRST=-1
04800 IDT=1
04900 C ABOVE 2 ARE IN TRANS. ROUTINES.
05000 PEAK=0
05100 CSS IPEAK=0
05200 RPEAK=0
05300 C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
05400 I2=1
05500 MS1=1
05600 MS3=MS1+(NPAR*NINS)-1
05700 MS2=NPAR
05800 I(4)=ISRT
05900 MOUT=1
06000
06100 C INITIALIZATION OF SECTION
06200 5 T(1)=0.0
06300 DO 220 N1=MS1,MS3,MS2
06400 C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
06500 220 RNT(N1)=-1
06600 DO 221 N1=1,NINS
06700 221 TI(N1)=90909.
06800
06900 C MAIN CARD READING LOOP
07000 204 CALL DATA (NREAD)
07100 IF(P(2)-T(1))200,200,244
07200 200 IOP=P(1)
07300 IF(IOP)201,201,202
07400 201 CALL ERROR(1)
07500 GO TO 204
07600
07700 202 IF(NOPCD-IOP)201,203,203
07800 203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
07900 11 IVAR=P3
08000 IVARE=IVAR+I(1)-4
08100 DO 297 N1=IVAR,IVARE
08200 IVARP=N1-IVAR+4
08300 297 I(N1)=P(IVARP)
08400 C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
08500 IF(N1.EQ.8)NBUF=512+512*I(N1)
08600 C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
08700 GO TO 204
08800 3 IGEN=P3
08900 IF(IGEN.NE.1)GO TO 282
09000 CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
09100 281 CALLGEN1
09200 GO TO 204
09300 282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
09400 CALLGEN2
09500 GO TO 204
09600
09700 4 IVAR=P3
09800 IVARE=IVAR+I(1)-4
09900 DO 296N1=IVAR,IVARE
10000 IVARP=N1-IVAR+4
10100 296 I(N1+100)=P(IVARP)
10200 GO TO 204
10300 6 CALL FROUT3(IDSK)
10400 CCCC STOP
10500 GO TO 1000
10600
10700 C ENTER NOTE TO BE PLAYED
10800 1 DO 230N1=MS1,MS3,MS2
10900 230 IF(RNT(N1).EQ.-1)GO TO 231
11000 CALL ERROR(2)
11100 C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
11200 TYPE 1230,NINS
11300 GO TO 204
11400 1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
11500 231 M1=N1
11600 M2=N1+I(1)-1
11700 M3=M2+1
11800 M4=N1+NPAR-1
11900 DO 232N1=M1,M2
12000 M5=N1-M1+1
12100 232 RNT(N1)=P(M5)
12200 RNT(M1 )=P3
12300 DO 233N1=M3,M4
12400 233 RNT(N1)=0
12500 DO 235N1=1,NINS
12600 IF(TI(N1)-90909.)235,234,235
12700 234 TI(N1)=P(2)+P(4)
12800 ITI(N1)=M1
12900 GO TO 204
13000 235 CONTINUE
13100 CALL ERROR(3)
13200 GO TO 204
13300
13400 C DEFINE INSTRUMENT
13500 2 M1=I2
13600 M2=IFIX(P3)
13700 IDEF(M2)=M1
13800 218 CALL DATA (NREAD)
13900 IF(I(1)-2)210,210,211
14000 210 INS(M1)=0
14100 I2=M1+1
14200 GO TO 204
14300 211 INS(M1)=P3
14400 M3=I(1)
14500 INS(M1+1)=M1+M3-1
14600 M1=M1+2
14700 DO 217N1=4,M3
14800 M5=P(N1)
14900 IF(M5)212,213,213
15000 212 IF(M5+100)300,301,301
15100 300 INS(M1)=-1+(M5+101)*LFUNC
15200 GO TO 216
15300 301 INS(M1)=-1+(M5+1)*LBLK
15400 GO TO 216
15500 213 IF(M5- 100 )214,214,215
15600 214 INS(M1)=M5
15700 GO TO 216
15800 215 INS(M1)=M5+26262
15900 C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
16000 C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
16100 216 M1=M1+1
16200 217 CONTINUE
16300 GO TO 218
16400
16500 C PLAY TO ACTION TIME
16600 244 T2=P(2)
16700 250 TMIN=90909.
16800 IREST=1
16900 DO 241N1=1,NINS
17000 IF(TMIN-TI(N1))241,241,240
17100 240 TMIN=TI(N1)
17200 MNOTE=N1
17300 241 CONTINUE
17400 IF(90909.-TMIN)251,251,243
17500 243 IF(TMIN-T2)245,245,246
17600 245 T3=TMIN
17700 GO TO 260
17800 246 T3=T2
17900 GO TO 260
18000 247 IF(T(1)-T2)249,200,200
18100 249 TI(MNOTE)=90909.
18200 M2=ITI(MNOTE)
18300 RNT(M2)=-1
18400 GO TO 250
18500
18600 C SETUP REST
18700 251 T3=T2
18800 IREST=2
18900 GO TO 260
19000
19100 C PLAY
19200 260 ISAM=(T3-T(1))*FLOAT(I(4))+.5
19300 T(1)=T3
19400 IF(ISAM)247,247,266
19500 266 IF(ISAM-LBLK)262,262,263
19600 262 I5=ISAM
19700 ISAM=0
19800 GO TO 264
19900 263 I5=LBLK
20000 ISAM=ISAM-LBLK
20100 264 IF(I(8))290,290,291
20200 290 M3=MOUT+I5-1
20300 MSAMP=I5
20400 GO TO 292
20500 291 M3=MOUT+(2*I5)-1
20600 MSAMP=2*I5
20700 292 DO 267N1=MOUT,M3
20800 267 ROUT(N1)=0
20900 GO TO (268,265),IREST
21000
21100 268 DO 270 NS1=MS1,MS3,MS2
21200 IF(RNT(NS1)+1)271,270,271
21300 C GO THROUGH UNIT GENERATORS IN INSTRUMENT
21400 271 I(3)=NS1
21500 IGEN=RNT(NS1)
21600 IGEN=IDEF(IGEN)
21700 272 I6=IGEN
21800 294 CALL FORSAM
21900 295 IGEN=INS(IGEN+1)
22000 IF(INS(IGEN))270,270,272
22100 270 CONTINUE
22200 265 CALL SAMOUT(IDSK ,MSAMP)
22300 IF(ISAM)247,247,266
22400 END
22500
22600 CDATA3 PASS 3 DATA INPUTING ROUTINE
22700 SUBROUTINE DATA (N)
22800 COMMON I(1)/P/ P(1) /FINOUT/PEAK,RPEAK /IFIRST/IFIRST,IDT
22900 CSS COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK
23000 EQUIVALENCE (K,I),(P2,P(2))
23100 CALL TRANS(IDT)
23200 CZZ READ (N) K,(P(J),J=1,K)
23300 IF(P(1).EQ.1)TYPE 1,P2
23400 IF(PEAK.LE.RPEAK)RETURN
23500 CSS IF(JPEAK.LE.IPEAK)RETURN
23600 TYPE 2,PEAK
23700 CSS TYPE 2,JPEAK
23800 RPEAK=PEAK
23900 CSS IPEAK=JPEAK
24000 C TYPES OUT EACH NEW PEAK AMPL.
24100 RETURN
24200 1 FORMAT('+',F9.2,$)
24300 2 FORMAT('+ AMPL=',F5.0,$)
24400 CSS2 FORMAT('+ AMPL=',I4,$)
24500 END
24600
24700 SUBROUTINE FROUT3(IDSK)
24800 C TERMINATE OUTPUT
24900 COMMON /ROUT/ROUT(1) /FINOUT/PEAK /CONV/CONV
25000 CC 1 /IFIRST/IFIRST,IDT
25100 CC IFIRST=-1
25200 CC IDT=0
25300 C THE ABOVE ARE RESETS TO GET BACK TO 'INPUT?'
25400 DO 1 K=1,512
25500 1 ROUT(K)=0
25600 CALL SAMOUT(IDSK,512)
25700 TYPE 10,PEAK
25800 C NOW CLOSE OFF THE FILE
25900 IF(CONV.NE.0)GO TO 3
26000 END FILE 23
26100 RETURN
26200 3 CALL FINFIL
26300 TYPE 2
26400 RETURN
26500 2 FORMAT(' 11.DMD WAS WRITTEN ********')
26600 10 FORMAT ('0PEAK AMPLITUDE WAS ',F7.0)
26700 END